home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Commodore Disk User Volume 4 #11
/
Commodore_Disk_User_Vol.4_11_1991_-.d64
/
udg compressor
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-10-26
|
3KB
|
67 lines
1 poke53280,0:poke53281,0:printchr$(8):poke53272,20
2 print"[147]humpty software character set compressor"
3 print"(c) and written humpty damien marsh 1988"
4 print"for use by humpty software personal only"
5 print"char.set should already have been loaded"
6 print"what memory position does the set begin?"
7 gosub50:ifa<6000ora>53000or(a>40000anda<49000)ora/2048<>int(a/2048)then7
8 s=a:print"last char.in set is char.no. (inclusive)"
9 gosub50:ifa<2ora>255then9
10 l=a:print"scanning set for duplicates. please wait"
11 dimc(l),d(l),e(l):c(0)=256:e=0:fori=1tol:forj=0toi-1:f=0
12 fork=0to7:ifpeek(s+i*8+k)<>peek(s+j*8+k)thenf=1
13 next:onfgoto14:c(i)=j:j=i:goto15
14 c(i)=256:e=1
15 next:next:ife=0thenprint"sorry, there's no duplicates in char.set":goto49
16 print"scan complete. table of duplicates ready"
17 print"print table of duplicates on the screen?"
18 gosub51:on1-(a$="n")-(2*(a$="y"))goto18,19:f=1:gosub52
19 print"list table of duplicates to the printer?"
20 print"if 'y' then ensure that printer is ready"
21 gosub51:on1-(a$="n")-(2*(a$="y"))goto21,23:f=0:open1,4:cmd1:gosub52
22 printchr$(13)
23 close1:open3,3:cmd3:print"options: (q)uit now,(d)elete duplicates,"
24 print"[145](c)ompress charset. press (q),(d) or (c)"
25 gosub51:on((a$="q")*-1)+((a$="d")*-2)+((a$="c")*-3)+1goto25,49,26,34
26 print"number to fill deleted characters with ?"
27 gosub50:ifa<0ora>255then28
28 print"filling duplicates with the above number"
29 f=a:fori=0tol:ifc(i)<256thenforj=0to7:pokes+i*8+j,f:next
30 next:print"complete. duplicates are now all deleted"
31 fori=0tol:ifc(i)<256thend(i)=c(i):goto33
32 d(i)=i
33 next:goto43
34 print"removing duplicates and compressing set.":z=0:d(0)=0
35 z=z+1:d(z)=z:ifc(z)=256then35
36 j=z:fori=ztol:fork=0to7:poke14336+j*8+k,peek(14336+i*8+k):next
37 ifc(i)=256thend(i)=j:j=j+1:goto39
38 d(i)=d(c(i))
39 next:l1=j-1:print"complete. number to fill excess chars ?"
40 gosub50:ifa<0ora>255then40
41 z=a:fori=s+l1*8tos+2047:pokei,z:next
42 print"complete. there are now"l1"chars used."
43 print"list old chars/new chars table to screen"
44 gosub51:on1-(a$="n")-(2*(a$="y"))goto44,45:f=1:gosub60
45 print"list old char/new char table to printer?"
46 gosub51:on1-(a$="n")-(2*(a$="y"))goto46,48:f=0:open1,4:cmd1:gosub60
47 printchr$(13):close1:close3:open3,3:cmd3
48 print"i suggest that you save your new set now"
49 print"[145][155]":end
50 gosub51:a=val(a$)-((a$="0")/10):on-(a=0)goto50:a=int(a):return
51 poke19,2:print"[145]>";:inputa$:poke19,0:print:return
52 print:gosub58
53 fori=0tol:printitab(20):ifc(i)=256thenprint"*****":goto55
54 printc(i)
55 ifpeek(214)=24andf=1thenwait198,1:poke198,0:gosub58
56 next:iff=1andpeek(214)>17thenwait198,1:poke198,0
57 return
58 iffthenprint"[147]";
59 print"character number"spc(4)"is identical to":print:return
60 print:gosub65
61 fori=0tol:printitab(20)d(i)
62 ifpeek(214)=24andf=1thenwait198,1:poke198,0:gosub65
63 next:iff=1andpeek(214)>19thenwait198,1:poke198,0
64 return
65 iffthenprint"[147]";
66 print"old charset"spc(9)"new charset":print:return